home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / comm / suncom.zip / TPZ.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-18  |  50KB  |  1,883 lines
  1. UNIT TPZ;
  2. INTERFACE
  3. USES Crt, Dos, TPZasync, TPZVideo, TPZFiles, TPZunix, TPZcrc;
  4.  
  5. FUNCTION Zmodem_Receive(path: STRING; comport: WORD; baudrate: LONGINT): BOOLEAN;
  6. FUNCTION Zmodem_Send(pathname: STRING; lastfile: BOOLEAN; comport: WORD; baudrate: LONGINT): BOOLEAN;
  7.  
  8. IMPLEMENTATION
  9.  
  10. CONST
  11.    TPZVER = 'TPZ [Zmodem] 2.1ß';
  12.    ZBUFSIZE = 1024;
  13.    zport: WORD = 1;
  14.    zbaud: LONGINT = 0;
  15.  
  16. TYPE
  17.    hdrtype = ARRAY[0..3] OF BYTE;
  18.    buftype = ARRAY[0..1023] OF BYTE;
  19.  
  20. CONST
  21.    ZPAD = 42;  { '*' }
  22.    ZDLE = 24;  { ^X  }
  23.    ZDLEE = 88;
  24.    ZBIN = 65;  { 'A' }
  25.    ZHEX = 66;  { 'B' }
  26.    ZBIN32 = 67;{ 'C' }
  27.    ZRQINIT = 0;
  28.    ZRINIT = 1;
  29.    ZSINIT = 2;
  30.    ZACK = 3;
  31.    ZFILE = 4;
  32.    ZSKIP = 5;
  33.    ZNAK = 6;
  34.    ZABORT = 7;
  35.    ZFIN = 8;
  36.    ZRPOS = 9;
  37.    ZDATA = 10;
  38.    ZEOF = 11;
  39.    ZFERR = 12;
  40.    ZCRC = 13;
  41.    ZCHALLENGE = 14;
  42.    ZCOMPL = 15;
  43.    ZCAN = 16;
  44.    ZFREECNT = 17;
  45.    ZCOMMAND = 18;
  46.    ZSTDERR = 19;
  47.    ZCRCE = 104; { 'h' }
  48.    ZCRCG = 105; { 'i' }
  49.    ZCRCQ = 106; { 'j' }
  50.    ZCRCW = 107; { 'k' }
  51.    ZRUB0 = 108; { 'l' }
  52.    ZRUB1 = 109; { 'm' }
  53.    ZOK = 0;
  54.    ZERROR = -1;
  55.    ZTIMEOUT = -2;
  56.    RCDO = -3;
  57.    FUBAR = -4;
  58.    GOTOR = 256;
  59.    GOTCRCE = 360; { 'h' OR 256 }
  60.    GOTCRCG = 361; { 'i' "   "  }
  61.    GOTCRCQ = 362; { 'j' "   "  }
  62.    GOTCRCW = 363; { 'k' "   "  }
  63.    GOTCAN = 272;  { CAN OR  "  }
  64.  
  65. { xmodem paramaters }
  66. CONST
  67.    ENQ = 5;
  68.    CAN = 24;
  69.    XOFF = 19;
  70.    XON = 17;
  71.    SOH = 1;
  72.    STX = 2;
  73.    EOT = 4;
  74.    ACK = 6;
  75.    NAK = 21;
  76.    CPMEOF = 26;
  77.  
  78. { byte positions }
  79. CONST
  80.    ZF0 = 3;
  81.    ZF1 = 2;
  82.    ZF2 = 1;
  83.    ZF3 = 0;
  84.    ZP0 = 0;
  85.    ZP1 = 1;
  86.    ZP2 = 2;
  87.    ZP3 = 3;
  88.  
  89. { bit masks for ZRINIT }
  90. CONST
  91.    CANFDX = 1;    { can handle full-duplex          (yes for PC's)}
  92.    CANOVIO = 2;   { can overlay disk and serial I/O (ditto)       }
  93.    CANBRK = 4;    { can send a break - True but superfluous       }
  94.    CANCRY = 8;    { can encrypt/decrypt - not defined yet         }
  95.    CANLZW = 16;   { can LZ compress - not defined yet             }
  96.    CANFC32 = 32;  { can use 32 bit crc frame checks - true        }
  97.    ESCALL = 64;   { escapes all control chars. NOT implemented    }
  98.    ESC8 = 128;    { escapes the 8th bit. NOT implemented          }
  99.  
  100. { bit masks for ZSINIT }
  101. CONST
  102.    TESCCTL = 64;
  103.    TESC8 = 128;
  104.  
  105. { paramaters for ZFILE }
  106. CONST
  107. { ZF0 }
  108.    ZCBIN = 1;
  109.    ZCNL = 2;
  110.    ZCRESUM = 3;
  111. { ZF1 }
  112.    ZMNEW = 1;   {I haven't implemented these as of yet - most are}
  113.    ZMCRC = 2;   {superfluous on a BBS - Would be nice from a comm}
  114.    ZMAPND = 3;  {programs' point of view however                 }
  115.    ZMCLOB = 4;
  116.    ZMSPARS = 5;
  117.    ZMDIFF = 6;
  118.    ZMPROT = 7;
  119. { ZF2 }
  120.    ZTLZW = 1;   {encryption, compression and funny file handling }
  121.    ZTCRYPT = 2; {flags - My docs (03/88) from OMEN say these have}
  122.    ZTRLE = 3;   {not been defined yet                            }
  123. { ZF3 }
  124.    ZCACK1 = 1;  {God only knows...                               }
  125.  
  126. VAR
  127.    rxpos: LONGINT; {file position received from Z_GetHeader}
  128.    rxhdr: hdrtype;    {receive header var}
  129.    rxtimeout,
  130.    rxtype,
  131.    rxframeind: INTEGER;
  132.    attn: buftype;
  133.    secbuf: buftype;
  134.    fname: STRING;
  135.    fmode: INTEGER;
  136.    ftime,
  137.    fsize: LONGINT;
  138.    usecrc32: BOOLEAN;
  139.    zcps, zerrors: WORD;
  140.    txpos: LONGINT;
  141.    txhdr: hdrtype;
  142.    ztime: LONGINT;
  143.  
  144. CONST
  145.    lastsent: BYTE = 0;
  146.  
  147. FUNCTION Z_SetTimer: LONGINT;
  148. VAR
  149.    l: LONGINT;
  150.    h,m,s,x: WORD;
  151. BEGIN
  152.    GetTime(h,m,s,x);
  153.    l := LONGINT(h) * 3600;
  154.    l := l + LONGINT(m) * 60;
  155.    l := l + LONGINT(s);
  156.    Z_SetTimer := l
  157. END;
  158.  
  159. FUNCTION Z_FileCRC32(VAR f: FILE): LONGINT;
  160. VAR
  161.    fbuf: buftype;
  162.    crc: LONGINT;
  163.    bread, n: INTEGER;
  164. BEGIN {$I-}
  165.    crc := $FFFFFFFF;
  166.    Seek(f,0);
  167.    IF (IOresult <> 0) THEN
  168.       {null};
  169.    REPEAT
  170.       BlockRead(f,fbuf,ZBUFSIZE,bread);
  171.       FOR n := 0 TO (bread - 1) DO
  172.          crc := UpdC32(fbuf[n],crc)
  173.    UNTIL (bread < ZBUFSIZE) OR (IOresult <> 0);
  174.    Seek(f,0);
  175.    IF (IOresult <> 0) THEN
  176.       {null};
  177.    Z_FileCRC32 := crc
  178. END; {$I+}
  179.  
  180. FUNCTION Z_GetByte(tenths: INTEGER): INTEGER;
  181. (* Reads a byte from the modem - Returns RCDO if *)
  182. (* no carrier, or ZTIMEOUT if nothing received   *)
  183. (* within 'tenths' of a second.                  *)
  184. VAR
  185.    n: INTEGER;
  186. BEGIN
  187.    REPEAT
  188.       IF (NOT Z_Carrier) THEN
  189.       BEGIN
  190.          Z_GetByte := RCDO; { nobody to talk to }
  191.          Exit
  192.       END;
  193.       IF (Z_CharAvail) THEN
  194.       BEGIN
  195.          Z_GetByte := Z_ReceiveByte; { got character }
  196.          Exit
  197.       END;
  198.       Dec(tenths);              { dec. the count    }
  199.       Delay(100)                { pause 1/10th sec. }
  200.    UNTIL (tenths <= 0);
  201.    Z_GetByte := ZTIMEOUT        { timed out }
  202. END;
  203.  
  204. FUNCTION Z_qk_read: INTEGER;
  205. (* Just like Z_GetByte, but timeout value is in *)
  206. (* global var rxtimeout.                        *)
  207. BEGIN
  208.    Z_qk_read := Z_GetByte(rxtimeout)
  209. END;
  210.  
  211.  
  212. FUNCTION Z_TimedRead: INTEGER;
  213. (* A Z_qk_read, that strips parity and *)
  214. (* ignores XON/XOFF characters.        *)
  215. VAR
  216.    done: BOOLEAN;
  217.    c: INTEGER;
  218. BEGIN
  219.    done := FALSE;
  220.    REPEAT
  221.       c := Z_qk_read AND $FF7F                { strip parity }
  222.    UNTIL (c < 0) OR (NOT (Lo(c) IN [17,19])); { wait for other than XON/XOFF }
  223.    Z_TimedRead := c
  224. END;
  225.  
  226. PROCEDURE Z_SendCan;
  227. (* Send a zmodem CANcel sequence to the other guy *)
  228. (* 8 CANs and 8 backspaces                        *)
  229. VAR
  230.    n: BYTE;
  231. BEGIN
  232.    Z_ClearOutbound; { spare them the junk }
  233.    FOR n := 1 To 8 DO
  234.    BEGIN
  235.       Z_SendByte(CAN);
  236.       Delay(100)     { the pause seems to make reception of the sequence }
  237.    END;              { more reliable                                     }
  238.    FOR n := 1 TO 10 DO
  239.       Z_SendByte(8)
  240. END;
  241.  
  242. PROCEDURE Z_PutString(VAR p: buftype);
  243. (* Outputs an ASCII-Z type string (null terminated) *)
  244. (* Processes meta characters 221 (send break) and   *)
  245. (* 222 (2 second delay).                            *)
  246. VAR
  247.    n: INTEGER;
  248. BEGIN
  249.    n := 0;
  250.    WHILE (n < ZBUFSIZE) AND (p[n] <> 0) DO
  251.    BEGIN
  252.       CASE p[n] OF
  253.          221 : Z_SendBreak;
  254.          222 : Delay(2000)
  255.          ELSE
  256.             Z_SendByte(p[n])
  257.       END;
  258.       Inc(n)
  259.    END
  260. END;
  261.  
  262. PROCEDURE Z_PutHex(b: BYTE);
  263. (* Output a byte as two hex digits (in ASCII) *)
  264. (* Uses lower case to avoid confusion with    *)
  265. (* escaped control characters.                *)
  266. CONST
  267.    hex: ARRAY[0..15] OF CHAR = '0123456789abcdef';
  268. BEGIN
  269.    Z_SendByte(Ord(hex[b SHR 4]));  { high nybble }
  270.    Z_SendByte(Ord(hex[b AND $0F])) { low nybble  }
  271. END;
  272.  
  273. PROCEDURE Z_SendHexHeader(htype: BYTE; VAR hdr: hdrtype);
  274. (* Sends a zmodem hex type header *)
  275. VAR
  276.    crc: WORD;
  277.    n, i: INTEGER;
  278. BEGIN
  279.    Z_SendByte(ZPAD);                  { '*' }
  280.    Z_SendByte(ZPAD);                  { '*' }
  281.    Z_SendByte(ZDLE);                  { 24  }
  282.    Z_SendByte(ZHEX);                  { 'B' }
  283.    Z_PutHex(htype);
  284.    crc := UpdCrc(htype,0);
  285.    FOR n := 0 TO 3 DO
  286.    BEGIN
  287.       Z_PutHex(hdr[n]);
  288.       crc := UpdCrc(hdr[n],crc)
  289.    END;
  290.    crc := UpdCrc(0,crc);
  291.    crc := UpdCrc(0,crc);
  292.    Z_PutHex(Lo(crc SHR 8));
  293.    Z_PutHex(Lo(crc));
  294.    Z_SendByte(13);                    { make it readable to the other end }
  295.    Z_SendByte(10);                    { just in case                      }
  296.    IF (htype <> ZFIN) AND (htype <> ZACK) THEN
  297.       Z_SendByte(17);                 { Prophylactic XON to assure flow   }
  298.    IF (NOT Z_Carrier) THEN
  299.       Z_ClearOutbound
  300. END;
  301.  
  302. FUNCTION Z_PullLongFromHeader(VAR hdr: hdrtype): LONGINT;
  303. (* Stuffs a longint into a header variable - N.B. - bytes are REVERSED! *)
  304. VAR
  305.    l: LONGINT;
  306. BEGIN
  307.    l := hdr[ZP3];               { hard coded for efficiency }
  308.    l := (l SHL 8) OR hdr[ZP2];
  309.    l := (l SHL 8) OR hdr[ZP1];
  310.    l := (l SHL 8) OR hdr[ZP0];
  311.    Z_PullLongFromHeader := l
  312. END;
  313.  
  314. PROCEDURE Z_PutLongIntoHeader(l: LONGINT);
  315. (* Reverse of above *)
  316. BEGIN
  317.    txhdr[ZP0] := BYTE(l);
  318.    txhdr[ZP1] := BYTE(l SHR 8);
  319.    txhdr[ZP2] := BYTE(l SHR 16);
  320.    txhdr[ZP3] := BYTE(l SHR 24)
  321. END;
  322.  
  323. FUNCTION Z_GetZDL: INTEGER;
  324. (* Gets a byte and processes for ZMODEM escaping or CANcel s